JCSM Shareware Collection 1993 November/JCSM Shareware Collection - 1993-11.iso/cl760/rrtr10.lzh/RRTRACK.PRG

Text File | 1993-09-02 | 53KB | 2,220 lines

procedure MASTMENU
RESTORE FROM ident.mem ADDITIVE
CLEAR
IF .NOT. PRINDEF
PRINCON()
ENDIF
IF .NOT. PAIDFOR
REGREM()
ENDIF
CLEAR
@1,1 say mScrnForm[1]
@2,1 say mScrnForm[2]
@3,1 say mScrnForm[3]
@4,1 say mScrnForm[4]
@5,1 say mScrnForm[5]
@6,1 say mScrnForm[6]
@7,1 say mScrnForm[7]
@8,1 say mScrnForm[8]
@9,1 say mScrnForm[9]
@10,1 say mScrnForm[10]
@11,1 say mScrnForm[11]
@12,1 say mScrnForm[12]
@13,1 say mScrnForm[13]
@14,1 say mScrnForm[14]
@15,1 say mScrnForm[15]
@16,1 say mScrnForm[16]
@17,1 say mScrnForm[17]
@18,1 say mScrnForm[18]
@19,1 say mScrnForm[19]
@20,1 say mScrnForm[20]
@21,1 say mScrnForm[21]
@3,55-len(district)/2 say district
@4,55-len(troopnr)/2 say troopnr
IF .NOT. PAIDFOR
@5,55-len([UNREGISTERED EVALUATION COPY])/2 SAY [UNREGISTERED EVALUATION COPY]
ENDIF
cMenuTitle = [MASTER MENU]
#DEFINE cBoxString CHR(213)+CHR(205)+CHR(184)+CHR(179)+CHR(190)+CHR(205)+CHR(212)+CHR(179)+CHR(32)
@10,47,20,65 box cBoxString
@11,51 SAY cMenuTitle
@13,49 PROMPT "1-RANGERS"
@14,49 PROMPT "2-COMMANDERS"
@15,49 PROMPT "3-UPDATE RECORDS"
@16,49 PROMPT "4-REPORTS"
@17,49 PROMPT "5-PRINTER SELECT"
@18,49 PROMPT "6-BACKUP DATA"
@19,49 PROMPT "EXIT"
MENU TO choice
DO CASE
CASE choice == 1
SCTMENU()
CASE choice == 2
SCTRMENU()
CASE choice == 3
RECMAIN()
CASE choice == 4
REPMENU()
CASE choice == 5
PRINCON()
CASE choice == 6
FILEBACK()
CASE choice == 7
CLEAR
?[Thanks for using RR TRACKER]
?
QUIT
ENDCASE
*--------------------------------------------------------------------
PROCEDURE SCTMENU
@15,4,20,31 BOX cBoxString
@16,5 PROMPT "ADD A RANGER'S RECORD"
@17,5 PROMPT "VIEW/EDIT A RANGER'S RECORD"
@18,5 PROMPT "DELETE A RANGER'S RECORD"
@19,5 PROMPT "RETURN TO MASTER MENU"
MENU TO choice2
DO CASE
CASE choice2 == 1
ADDRCD("Y")
CASE choice2 == 2
VEMENU()
CASE choice2 == 3
DELREC()
CASE choice2 == 4
RETURN
ENDCASE
RETURN
*--------------------------------------------------------------------
PROCEDURE SCTRMENU
@15,4,20,33 BOX cBoxString
@16,5 PROMPT "ADD AN COMMANDER'S RECORD"
@17,5 PROMPT "VIEW/EDIT AN COMMANDER'S RECORD"
@18,5 PROMPT "DELETE AN COMMANDER'S RECORD"
@19,5 PROMPT "RETURN TO MASTER MENU"
MENU TO choice2
DO CASE
CASE choice2 == 1
ADDRCD("A")
CASE choice2 == 2
VEMENU()
CASE choice2 == 3
DELREC()
CASE choice2 == 4
RETURN
ENDCASE
RETURN
*---------------------------------------------------------------------
PROCEDURE RECMAIN
*PROCEDURE TO DETERMINE WHICH .DBF WILL BE UPDATED WITH DATA
@14,19,23,53 BOX cBoxString
@15,20 PROMPT "1 - ADD MERIT EARNED"
@16,20 PROMPT "2 - ADD TRAINING EXPERIENCE"
@17,20 PROMPT "3 - ADD ADVANCEMENT EARNED"
@18,20 PROMPT "4 - ADD OFFICE HELD"
@19,20 PROMPT "5 - ADD UNIFORM INSPECTION SCORES"
@20,20 PROMPT "6 - ADD OUTPOST ACTIVITY"
@21,20 PROMPT "7 - ADD MEETING ATTENDANCE"
@22,20 PROMPT "8 - RETURN TO MASTER MENU"
MENU TO choice3
DO CASE
CASE choice3 = 1
ADDAT("A")
CASE choice3 = 2
ADDAT("C")
CASE choice3 = 3
ADDAT("B")
CASE choice3 = 4
ADDAT("D")
CASE choice3 = 5
UNIADD()
CASE choice3 = 6
TRPACTY()
CASE choice3 = 7
ATTEND()
CASE choice3 = 8
RETURN
OTHERWISE
RETURN
ENDCASE
RETURN
*---------------------------------------------------------------------
PROCEDURE REPMENU
@15,1,20,34 BOX cBoxString
@16,2 PROMPT "1 - PRINT ROSTER DATA"
@17,2 PROMPT "2 - PRINT MAILING LABELS"
@18,2 PROMPT "3 - PRINT/VIEW FORMATTED REPORTS"
@19,2 PROMPT "4 - RETURN TO MASTER MENU"
MENU TO choice2
DO CASE
CASE choice2 == 1
MENROST()
CASE choice2 == 2
MENLABE()
CASE choice2 == 3
MENREP()
CASE choice2 == 4
RETURN
ENDCASE
RETURN
*--------------------------------------------------------------------
PROCEDURE MENROST
@15,40,22,74 BOX cBoxString
@16,41 PROMPT "1 - OUTPOST ROSTER (RANGERS ONLY)"
@17,41 PROMPT "2 - OUTPOST ROSTER (COMMANDERS ONLY)"
@18,41 PROMPT "3 - PATROL ROSTER"
@19,41 PROMPT "4 - FORMER MEMBERS ROSTER"
@20,41 PROMPT "5 - OUTPOST TELEPHONE CALL SHEET"
@21,41 PROMPT "6 - RETURN TO MASTER MENU"
MENU TO choice2
MSG4 = [  Please ensure that your printer is online and ready.]
DO CASE
CASE choice2 == 1
SET MARGIN TO 2
SET DEVICE TO PRINTER
set prin on
?mboldon
set prin off
SET CONSOLE OFF
@ 2,40-len([ASSEMBLIES OF GOD ROYAL RANGERS])/2 SAY [ASSEMBLIES OF GOD ROYAL RANGERS]
@ 4,40-LEN(DISTRICT)/2 SAY DISTRICT
@ 5,40-LEN(TROOPNR)/2 SAY TROOPNR
@ 6,40-len([ROSTER OF RANGERS])/2 SAY [ROSTER OF RANGERS]
@ 7,5 SAY [Effective Date: ]+dtoc(date())
USE ROSTER
INDEX on lname+fname to temp
GO TOP
SET PRINT ON
?mboldoff
?mprcomp
SET PRINT OFF
LABEL FORM ROSTER TO PRINT FOR MBRNR <500
CLOSE DATABASES
SET PRINT ON
?mpr10cpi
SET PRINT OFF
SET CONSOLE ON
SET MARGIN TO 5
SET DEVICE TO SCREEN
EJECT
CASE choice2 == 2
SET MARGIN TO 2
set prin on
?mboldon
set prin off
SET DEVICE TO PRINTER
SET CONSOLE OFF
@ 2,40-len([ASSEMBLIES OF GOD ROYAL RANGERS])/2 SAY [ASSEMBLIES OF GOD ROYAL RANGERS]
@ 4,40-LEN(DISTRICT)/2 SAY DISTRICT
@ 5,40-LEN(TROOPNR)/2 SAY TROOPNR
@ 6,40-len([ROSTER OF COMMANDERS])/2 SAY [ROSTER OF COMMANDERS]
@ 7,5 SAY [Effective Date: ]+dtoc(date())
SET DEVICE TO SCREEN
USE ROSTER
INDEX on lname+fname to temp
GO TOP
SET PRINT ON
?mboldoff
?mprcomp
SET PRINT OFF
LABEL FORM COMIT ALL TO PRINT FOR MBRNR >499
CLOSE DATABASES
SET PRINT ON
?mpr10cpi
sET PRINT OFF
SET MARGIN TO 5
SET CONSOLE ON
EJECT
CASE choice2 == 3
USE ROSTER
INDE ON PATROL TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
SET CONSOLE OFF
SET PRINT ON
?mboldoff
?mprcomp
SET PRINT OFF
REPORT FORM PATROST HEADING TROOPNR+[;]+[PATROL ROSTER] TO PRINT
CLOSE DATABASES
SET PRINT ON
?mpr10cpi
SET PRINT OFF
SET CONSOLE ON
CASE choice2 == 4
SET MARGIN TO 2
set prin on
?mboldon
set prin off
SET DEVICE TO PRINTER
SET CONSOLE OFF
@ 1,40-len([ASSEMBLIES OF GOD ROYAL RANGERS])/2 SAY [ASSEMBLIES OF GOD ROYAL RANGERS]
@ 3,40-LEN(DISTRICT)/2 SAY DISTRICT
@ 4,40-LEN(TROOPNR)/2 SAY TROOPNR
@ 5,40-len([ROSTER OF FORMER MEMBERS])/2 SAY [ROSTER OF FORMER MEMBERS]
@ 6,5 SAY [Effective Date: ]+dtoc(date())
SET DEVICE TO SCREEN
USE FORMRMBR
INDEX ON LNAME+FNAME TO TEMP
GO TOP
SET PRINT ON
?mboldoff
?mprcomp
SET PRINT OFF
LABEL FORM FORMRMBR ALL TO PRINT
CLOSE DATABASES
SET PRINT ON
?mpr10cpi
SET PRINT OFF
SET MARGIN TO 5
EJECT
CASE choice2 == 5
*a procedure that will print a list of all members with their names,
*home phone, mother & fathers office phones or member's office phone
clear
@10,20 say [Printing specified report...]
set console off
use roster
inde on lname+fname to temp
SET FILTER TO MBRNR < 500
go top
repo form callshet heading +district+";"+troopnr+";"+[OUTPOST RANGER CALL LIST] TO PRINT
SET FILTER TO MBRNR >499
GO TOP
repo form callshet heading district+";"+troopnr+";"+[OUTPOST COMMANDER CALL LIST] TO PRINT
close data
erase temp.ntx
set console on
return
CASE choice2 == 6
RETURN
OTHERWISE
RETURN
ENDCASE
RETURN
*--------------------------------------------------------------------
PROCEDURE MENLABE
CLEAR
@3,40-LEN([LABEL SELECTION MENU])/2 SAY [LABEL SELECTION MENU]
@5,5,14,29 BOX cBoxString
@6,11 SAY [LABEL STYLES]
@7,6 PROMPT "'TO THE PARENTS OF:...'"
@8,6 PROMPT "OUTPOST COMMANDERS ONLY"
@9,6 PROMPT "GENERIC OUTPOST LABEL"
@10,6 PROMPT "RETURN TO MASTER MENU"
MENU TO choice2
DO CASE
CASE choice2 == 1
MENSIZE("A")
CASE choice2 == 2
MENSIZE("B")
CASE choice2 == 3
MENSIZE("C")
CASE choice2 == 4
RETURN
ENDCASE
RETURN
*---------------------------------------------------------------------
PROCEDURE MENSIZE
PARAMETER mLabeType
@5,30,15,65 BOX cBoxString
@6,43 SAY [LABEL SIZES]
@7,32 PROMPT [1 - 3.5" x 15/16" x 1]
@8,32 PROMPT [2 - 3.5" x 15/16" x 2]
@9,32 PROMPT [3 - 3.5" x 15/16" x 3]
@10,32 PROMPT [4 - 4" x 1 7/16" x 1]
@11,32 PROMPT [5 - 3.2" x 11/12 x 3 CHESHIRE]
@12,32 PROMPT [6 - ASCII FILE, Comma Delimited]
@13,32 PROMPT [7 - ASCII FILE, No Delimiters]
@14,32 PROMPT [8 - RETURN TO MASTER MENU]
MENU TO choice3
if choice3 == 8
return
endif
MSG1 = [PRESS ANY KEY WHEN PRINTER IS ONLINE AND READY TO GO]
MSG2 = [CREATING FILE "MAILING.TXT" WITH DESIGNATED RECORDS.]
MSG3 = [RR TRACKER WILL NOT PRODUCE ASCII FILE AS REQUESTED.]
MSG4 = [PRESS ANY KEY TO CONTINUE]
@18,40-LEN(MSG1)/2 SAY MSG1
INKEY(0)
SET CONSOLE OFF
DO CASE
CASE choice3 == 1 .AND. mLabeType == [A]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
LABEL FORM PARX1 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 1 .AND. mLabeType == [B]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
LABEL FORM 3515161 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 1 .AND. mLabeType == [C]
SET MARGIN TO 0
USE RETURN
COUNTER = 0
DO WHILE COUNTER < 25
go bottom
append blank
REPL DISTNAME WITH DISTRICT
REPL TRPNR WITH TROOPNR
COUNTER = COUNTER+1
ENDDO WHILE COUNTER < 25
GO TOP
LABEL FORM GENX1 SAMPLE TO PRINT
USE RETURN
SET SAFETY OFF
ZAP
SET SAFETY ON
CLOSE DATA
SET MARGIN TO 5
CASE choice3 == 2 .AND. mLabeType == [A]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
LABEL FORM PARX2 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 2 .AND. mLabeType == [B]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
LABEL FORM 3515162 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 1 .AND. mLabeType == [C]
SET MARGIN TO 0
USE RETURN
COUNTER = 0
DO WHILE COUNTER < 25
go bottom
append blank
REPL DISTNAME WITH DISTRICT
REPL TRPNR WITH TROOPNR
COUNTER = COUNTER+1
ENDDO WHILE COUNTER < 25
GO TOP
LABEL FORM GENX2 SAMPLE TO PRINT
USE RETURN
SET SAFETY OFF
ZAP
SET SAFETY ON
CLOSE DATA
SET MARGIN TO 5
CASE choice3 == 3 .AND. mLabeType == [A]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
LABEL FORM PARX3 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 3 .AND. mLabeType == [B]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
LABEL FORM 3515163 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 3 .AND. mLabeType == [C]
SET MARGIN TO 0
USE RETURN
COUNTER = 0
DO WHILE COUNTER < 25
go bottom
append blank
REPL DISTNAME WITH DISTRICT
REPL TRPNR WITH TROOPNR
COUNTER = COUNTER+1
ENDDO WHILE COUNTER < 25
GO TOP
LABEL FORM GENX3 SAMPLE TO PRINT
USE RETURN
SET SAFETY OFF
ZAP
SET SAFETY ON
CLOSE DATA
SET MARGIN TO 5
CASE choice3 == 4 .AND. mLabeType == [A]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
LABEL FORM PARX4 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 4 .AND. mLabeType == [B]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
LABEL FORM 3515161 SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 4 .AND. mLabeType == [C]
SET MARGIN TO 0
USE RETURN
COUNTER = 0
DO WHILE COUNTER < 25
go bottom
append blank
REPL DISTNAME WITH DISTRICT
REPL TRPNR WITH TROOPNR
COUNTER = COUNTER+1
ENDDO WHILE COUNTER < 25
GO TOP
LABEL FORM GENX4 SAMPLE TO PRINT
USE RETURN
SET SAFETY OFF
ZAP
SET SAFETY ON
CLOSE DATA
SET MARGIN TO 5
CASE choice3 == 5 .AND. mLabeType == [A]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
LABEL FORM PARCHES SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 5 .AND. mLabeType == [B]
USE ROSTER
INDE ON ZIP+PLUS4 TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
LABEL FORM CHESHIRE SAMPLE TO PRINT
CLOSE DATA
ERASE TEMP.NDX
CASE choice3 == 5 .AND. mLabeType == [C]
SET MARGIN TO 0
USE RETURN
COUNTER = 0
DO WHILE COUNTER < 25
go bottom
append blank
REPL DISTNAME WITH DISTRICT
REPL TRPNR WITH TROOPNR
COUNTER = COUNTER+1
ENDDO WHILE COUNTER < 25
GO TOP
LABEL FORM GENCHES SAMPLE TO PRINT
USE RETURN
SET SAFETY OFF
ZAP
SET SAFETY ON
CLOSE DATA
SET MARGIN TO 5
CASE choice3 == 6 .AND. mLabeType == [A]
*PRODUCES A COMMA DLIMITED ASCII FILE CONTAINING DATA MEETING SELECTED
*CRITERIA
@20,40-LEN(MSG2)/2 SAY MSG2
USE ROSTER
INDE ON ZIP TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
COPY TO MAILING.TXT FIELDS FNAME,LNAME,ADDRESS,CITY,STATE,ZIP DELIMITED
CLOSE DATA
ERASE TEMP.NTX
CASE choice3 == 6 .AND. mLabeType == [B]
*PRODUCES A COMMA DLIMITED ASCII FILE CONTAINING DATA MEETING SELECTED
*CRITERIA
@20,40-LEN(MSG2)/2 SAY MSG2
USE ROSTER
INDE ON ZIP TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
COPY TO MAILING.TXT FIELDS FNAME,LNAME,ADDRESS,CITY,STATE,ZIP DELIMITED
CLOSE DATA
ERASE TEMP.NTX
CASE choice3 == 6 .AND. mLabeType == [C]
@20,40-LEN(MSG3)/2 SAY MSG3
@21,40-LEN(MSG4)/2 SAY MSG4
INKEY(0)
CASE choice3 == 7 .AND. mLabeType == [A]
@20,40-LEN(MSG2)/2 SAY MSG2
USE ROSTER
INDE ON ZIP TO TEMP
SET FILTER TO MBRNR < 500
GO TOP
COPY TO MAILING.TXT FIELDS FNAME,LNAME,STREET,CITY,STATE,ZIP SDF
CLOSE DATA
ERASE TEMP.NTX
CASE choice3 == 7 .AND. mLabeType == [B]
@20,40-LEN(MSG2)/2 SAY MSG2
USE ROSTER
INDE ON ZIP TO TEMP
SET FILTER TO MBRNR > 499
GO TOP
COPY TO MAILING.TXT FIELDS FNAME,LNAME,STREET,CITY,STATE,ZIP SDF
CLOSE DATA
ERASE TEMP.NTX
CASE choice3 == 7 .AND. mLabeType == [C]
@20,40-LEN(MSG3)/2 SAY MSG3
@21,40-LEN(MSG4)/2 SAY MSG4
INKEY(0)
OTHERWISE
RETURN
ENDCASE
SET CONSOLE ON
RETURN
*---------------------------------------------------------------------
PROCEDURE MENREP
@13,35,22,74 BOX cBoxString
@14,36 PROMPT "1 - VIEW OUTPOST ATTENDANCE REPORT"
@15,36 PROMPT "2 - PRINT OUTPOST ATTENDANCE REPORT"
@16,36 PROMPT "3 - PRINT INDIVIDUAL RECORD"
@17,36 PROMPT "4 - VIEW SKILLS SEARCH REPORT"
@18,36 PROMPT "5 - PRINT SKILLS SEARCH REPORT"
@19,36 PROMPT "6 - PRINT PRE-COUNCIL OF ACHIEVEMENT HONORS REPORT"
MENU TO choice2
MSG4 = [  Please ensure that your printer is online and ready.]
@23,40-LEN(MSG4)/2 SAY MSG4
DO CASE
CASE choice2 == 1
PRINATT("V")
CASE choice2 == 2
PRINATT("P")
CASE choice2 == 3
PRININDV()
CASE choice2 == 4
PRINSKIL("V")
CASE choice2 == 5
PRINSKIL("P")
CASE choice2 == 6
HONORS()
OTHERWISE
RETURN
ENDCASE
RETURN
*---------------------------------------------------------------------
*A procedure to add records to ROSTER.DBF
PROCEDURE Addrcd
PARAMETERS ADDMBR
clear
store upper(addmbr) to addmbr
SET TALK OFF
USE ROSTER
INDE ON MBRNR TO TEMP
SET FILTER TO MBRNR < 500
GO BOTT
STORE MBRNR TO LASTSC
IF LASTSC = 0
LASTSC = LASTSC+1
ENDIF
SET FILT TO MBRNR > 499
GO BOTT
STORE MBRNR TO LASTAD
IF LASTAD = 0
LASTAD = LASTAD+501
ENDIF
CLOSE DATABASES
erase TEMP.NTX
USE Roster
INDEX ON LNAME+FNAME TO TEMP
GO BOTT
APPEND BLANK
repl begdate with date()
do case
case addmbr = [A]
lastad = lastad+1
repl mbrnr with lastad
case addmbr = [Y]
lastsc = lastsc+1
repl mbrnr with lastsc
endcase
FILBLAN1()
READ
IF LEN(TRIM(LNAME)) > 0
IsBlank = .F.
else
IsBlank = .T.
ENDIF LEN(TRIM(LNAME)) >0
IF ISBLANK
DELETE
ENDIF ISBLANK
USE Roster INDE temp
PACK
CLOSE DATA
ERASE TEMP.NTX
CLEAR
RETURN
*END Addrcd
*___________________________________________________________________________
procedure filblan1
clear
@ 0,0 SAY "RECORD:"
@ 0,8 SAY RECNO() PICTURE "999"
@ 0,72 SAY DATE()
@ 1,0 SAY " "
TEXT
 PERSONAL│
   DATA  │  First Name & Initials       Family Name           Member Number
         │
         │
         │  Street or P.O. Box Address     City                  State
         │
         │       ZIP     Plus 4                            Area  Telephone
         │              (if known)                         Code
 ──────┬─┴──────────────────────────────────────────────────────────────────
 OUT-  │
  POST │    Patrol          Office            Advance       Date
 DATA  │     Name           in O/P             Level         Adv
       │
 ──────┴────────────────────────────────────────────────────────────────────
                                  FAMILY DATA             M  D  Y
                                          Date of Birth:
 Mother's Name:                           Mom's Work Phone:
 Father's Name:                           Dad's Work Phone:
                                                            Area    Number Ext
                                                            Code
             ESC TO ABORT|<cr> TO MOVE TO NEXT BLANK|   TO MOVE BACK

ENDTEXT
IF INKEY() = 27
   RETURN
ENDIF
@2,12 get Fname picture [!!!!!!!!!!!!]
@2,40 get Lname picture [!!!!!!!!!!!!!!!]
@2,67 SAY mbrnr
@5,13 get address
@5,44 get city
@5,67 GET STATE
@7,17 get ZIP
@7,25 GET PLUS4
@7,58 get AREAcode
@7,67 get phone
@11,9 get patrol picture [!!!!!!!!!!!!!!!]
@11,30 get office picture [!!!!]
@11,45 get rank picture [!!!!!!!!!!]
@11,60 GET DOR picture [9999]
@17,57 get birthdate
@18,16 get momname picture [!XXXXXXXXXXXXXXXXXXXXXXXXX]
@18,60 get momareacod
@18,68 get momphone
@18,75 get momext
@19,16 get dadname PICTURE [!XXXXXXXXXXXXXXXXXXXXXXXXX]
@19,60 get dadAREAcod
@19,68 get dadphone
@19,75 get ext
@22,54 SAY CHR(24)
*end filblan1
*____________________________________________________________________________
PROCEDURE delrec
*PROCEDURE TO DELETE A member FROM ROSTER.DBF
CLEAR
ReadyAdd = .F.
DO WHILE .NOT. ReadyAdd
@1,0 SAY " "
TEXT
   The purpose of this module is to DELETE a member of the Outpost from the
   active database.  Be sure this is what you want to do before proceeding.
   This procedure will transfer all traces of a member to the FORMRMBR data-
   base where the information will be stored in perpetuity.
                  WARNING:  THIS IS AN IRREVERSIBLE PROCEDURE!

      Enter a Blank at the next prompt to abort this procedure.

endtext
ACCEPT [     Please type in Member's LAST name: ] to cGetName
if len(trim(cGetName)) = 0
return
endif
STORE UPPER(cGetName) TO cGetName
USE Roster
INDE on lname+fname to temp
FIND &cGetName
CORRECTNAME = .F.
DO WHILE .NOT. CORRECTNAME
*Verify that the record "found" is the Counselor wanted.
CLEAR
DO filblan2
@22,0 say "Is this the Member who is to be DELETED FROM the DATABASE?"
WAIT [Y/N?  ] TO RightName
STORE UPPER(RightName) TO RightName
DO CASE
CASE RightName = [Y]
CORRECTNAME = .T.
ReadyAdd = .T.
CASE RIGHTnAME = [N]
SKIP
if eof()
?
?
?[The name you typed in apparently is not in the database.]
?[Please verify spelling and restart this procedure.]
wait
return
endif eof()
LOOP
ENDCASE
ENDDO WHILE .NOT. CORRECTNAME
ENDDO WHILE .NOT. ReadyAdd
CLEAR
mHoldname = FNAME
mNrHold=mbrnr
DELETE
USE actylog
?
?[CLEARING DATA FROM ACTIVITY LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
USE advance
?
?[CLEARING DATA FROM ADVANCEMENT LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
USE attend
?
?[CLEARING DATA FROM ATTENDANCE LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
USE merit
?
?[CLEARING DATA FROM MERIT BADGE LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
USE office
?
?[CLEARING DATA FROM OFFICES HELD LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
USE training
?
?[CLEARING DATA FROM TRAINING LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
USE uniform
?
?[CLEARING DATA FROM UNIFORM SCORES LOG]
DELE ALL FOR MBRNR = mNrHold
PACK
?
?[NOW ADDING ]+TRIM(mHoldName)+[ TO THE FORMER MEMBER DATABASE.]
USE Roster
SET FILTER TO DELETED()
COPY TO temp
SET FILTER TO
PACK
USE formrmbr
APPE FROM temp
REPL enddate WITH date()
RECALL ALL
CLOSE DATA
ERASE temp.dbf
RUN DEL *.ntx
RETURN
*END delrec
*____________________________________________________________________________
procedure filblan2
clear
@ 0,0 SAY "RECORD:"
@ 0,8 SAY RECNO() PICTURE "9,999,999"
@ 0,72 SAY DATE()
@ 1,0 SAY " "
TEXT
 PERSONAL│
   DATA  │  First Name & Initials       Family Name           Unique Member
         │                                                        Number
         │
         │  Street or P.O. Box Address                   City
         │
         │       ZIP     Plus 4                            Area  Telephone
         │              (if known)                         Code
 ──────┬─┴──────────────────────────────────────────────────────────────────
 OUT-  │
  POST │    Patrol          Office            Advance       Date
 DATA  │     Name           in T/P             Level         Adv
       │
 ──────┴────────────────────────────────────────────────────────────────────

                PRESS ESCAPE KEY TO ABORT THIS RECORD
                <cr> TO MOVE TO THE NEXT BLANK FIELD
ENDTEXT

IF INKEY() = 27
   RETURN
ENDIF
@2,12 get Fname picture [!!!!!!!!!!!!]
@2,40 get Lname picture [!!!!!!!!!!!!!!!]
@2,67 SAY mbrnr
@5,17 get address
@5,57 get city
@7,17 get ZIP
@7,25 GET PLUS4
@7,58 get AREAcode
@7,67 get phone
@11,9 get patrol picture [!!!!!!!!!!!!!!!]
@11,30 get office picture [!!!!]
@11,45 get rank picture [!!!!!!!!!!]
@11,60 GET DOR picture [9999]
*end filblan2
*____________________________________________________________________________
PROCEDURE VEMENU
*A PROCEDURE TO PROVIDE A MENU TO VIEW/EDIT THE VARIOUS COMPONENTS OF A
*SPECIFIC INDIVIDUAL'S RECORDS
@15,35,24,57 BOX cBoxString
@16,36 PROMPT "ROSTER DATA"
@17,36 PROMPT "ADVANCEMENT DATA"
@18,36 PROMPT "OFFICE HELD DATA"
@19,36 PROMPT "ACTIVITY DATA"
@20,36 PROMPT "MERIT BADGE DATA"
@21,36 PROMPT "TRAINING DATA"
@22,36 PROMPT "UNIFORM DATA"
@23,36 PROMPT "RETURN TO MASTER MENU"
MENU TO choice3
DO case
case choice3 = 1
TARGETDBF = "ROSTER"
case choice3 = 2
TARGETDBF = "ADVANCE"
case choice3 = 3
TARGETDBF = "OFFICE"
case choice3 = 4
TARGETDBF = "ACTYLOG"
case choice3 = 5
TARGETDBF = "MERIT"
case choice3 = 6
TARGETDBF = "TRAINING"
case choice3 = 7
TARGETDBF = "UNIFORM"
otherwise
RETURN
ENDCASE
SCEDIT()
*END EDITMENU
*-------------------------------------------------------------------------
PROCEDURE scedit
*A procedure to edit records in ROSTER.DBF
CLEAR
corname = .f.
do while .not. corname
ACCEPT [   Which member's record do you wish to edit? (LAST NAME)  ] to choice
if len(ltrim(choice)) = 0
clear all
RETURN
endif
store upper(choice) to choice
use ROSTER
inde on lname+fname to temp
go top
find &choice
if .not. found()
?
?[A record with that Last Name does not exist in the database.  Please]
?[re-enter that Last Name again.]
loop
endif
corname = .t.
CORRECTNAME = .F.
DO WHILE .NOT. CORRECTNAME
*Verify that the record "found" is the RECORD wanted.
CLEAR
@5,5 SAY TRIM(FNAME)+[ ]+LNAME
@6,5 SAY ADDRESS
@10,10 say "Is this the Member who is to be EDITED?"
WAIT [Y/N?  ] TO RightName
STORE UPPER(RightName) TO RightName
DO CASE
CASE RightName = [Y]
CORRECTNAME = .T.
CASE RIGHTnAME = [N]
SKIP
if eof()
?
?
?[The name you typed in apparently is not in the database.]
?[Please verify spelling.]
wait
RETURN
endif eof()
LOOP
ENDCASE
ENDDO WHILE .NOT. CORRECTNAME
NAMEDIT = TRIM(FNAME)+[ ]+TRIM(LNAME)
GETMBRNR = MBRNR
Enddo while .not. corname
CLEAR
USE &TARGETDBF
?TARGETDBF
IF TARGETDBF = [ROSTER]
  SET FILTER TO LNAME = CHOICE
ELSE
  SET FILTER TO MBRNR = GETMBRNR
ENDIF
GO TOP
dispdat()
CLEAR
PACK
CLOSE DATABASES
run del *.ntx
RELEASE TARGETDBF
RETURN
*end scedit
*____________________________________________________________________________
PROCEDURE dispdat
TEXT

   ┌──────────────────────────────────────────────┐
   │  <cr>    │          │  Esc   │       │ Del   │
   │ Begin/   │  MOVE TO │ End    │ MOVE  │Delete │
   │  End     │  LFT/RT  │  Edit  │ UP/DN │Record │
   │ EDITING  │  COLUMN  │Session │ 1 ROW │       │
ENDTEXT
@ 1,50 SAY NAMEDIT
@ 4,19 say chr(27)
@ 4,22 say chr(26)
@ 4,38 say chr(24)
@ 4,41 say chr(25)
BROWSE(8,0,22,79)
*end RECEDIT
*___________________________________________________________________________
PROCEDURE ADDAT
PARAMETER GetDBF
CLEAR
?
?
?
ACCEPT [  Whose record do you want to update?  (Last Name) ] to getname
IF LEN(TRIM(GetName)) = 0
RETURN
ENDIF
STORE UPPER(getname) to getname
USE ROSTER
index on lname+fname to temp
go top
FIND &getname
?
proper = .n.
do while .not. proper
?[   The record to be modified belongs to:]
?[         ]+trim(fname)+[ ]+trim(lname)
?
wait [  Correct?  (Y/N)  ] to correct
store upper(correct) to correct
if correct = [N]
skip
if eof()
?[   The record you are looking for does not exist for]
??[ this Ranger]
?[   or Commander.  Please verify as to name and restart this]
??[ procedure.]
WAIT [   PRESS ESCAPE]
RETURN
endif
loop
endif
proper = .y.
enddo
store mbrnr to getnumber
CLOSE DATA
?
clear
?
?
?
*Now, to get that database and add a record
do case
case getdbf = [A]
ACCEPT [  What MERIT was earned? ] to earned
STORE UPPER(Earned) TO Earned
use MERIT
append blank
repl mbrnr with getnumber
repl badge with earned
accept [  What date was this MERIT earned? (YYMM) ] to date
repl earndate with date
close data
case getdbf = [B]
Accept [  What Advancement Level was earned? ] to earned
use ADVANCE
Append blank
store upper(earned) to earned
Repl mbrnr with getnumber
repl rank with earned
accept [  What date was this Advancement earned? (YYMM) ] to date
repl earndate with date
close data
case getdbf = [C]
accept [  What Training was completed? ] to earned
use TRAINING
append blank
store upper(earned) to earned
repl mbrnr with getnumber
repl tng with earned
accept [  What date was this training completed? (YYMM) ] to date
repl datecompl with date
close data
case getdbf = [D]
accept [  What office was earned or appointed? ] to earned
use OFFICE
Append blank
store upper(earned) to earned
repl mbrnr with getnumber
repl office with earned
accept [  What date did this Term of Office start? (YYMM) ] to date
repl begdate with date
close data
endcase
CLOSE DATA
run del *.ntx
RETURN
*end scupdate
*___________________________________________________________________________
procedure uniadd
CLEAR
TEXT
                       POSTING UNIFORM INSPECTION SCORES

  After you read this, you will be asked to provide the date of the meeting
  during which the inspection was held.  Once the computer has the re-
  quired data, it will then go through the troop roster asking you for the
  score of each member attended the meeting.  At the prompt, simply type in
  the numeric score for that Ranger (or Commander) and press Enter to go to
  the next record.
  Press any key to continue...
endtext
wait [ ]
*Obtaining the needed data for subsequent posting
info = .f.
do while .not. info
?
accept [  What Was the date of the meeting?  (YYMMDD)  ] to meetdate
clear
?
?[  The meeting date is:  ]+meetdate
?
?
wait [  Correct? (Y/N)  ] to correct
store upper(correct) to correct
if correct = [Y]
info = .t.
else
info = .f.
endif
enddo
clear
text

    You will now be presented with the name of each member of the Outpost.
 Type in the score each received on their inspection form when prompted to
 do so.

endtext
wait
select a
use roster
index on lname+fname to temp
select b
use uniform
select a
do while .not. eof()
clear
?[  Was ]+trim(fname)+[ ]+trim(lname)+[ inspected?]
wait [ (Y/N?)  ] to part
store upper(part) to part
if part = [N]
skip
loop
endif
store mbrnr to lognr
select b
append blank
replace mbrnr with lognr
replace date with meetdate
Accept [  What was his/her score? ] to scorein
store val(scorein) to scorein
repl score with scorein
select a
skip
enddo
close databases
run del *.ntx
RETURN
*END UNIADD
*____________________________________________________________________________
PROCEDURE TRPACTY
*A PROGRAM THAT WILL ALLOW OPERATOR TO LOG A CAMPING ACTIVITY
*THE PROGRAM WILL SOLICIT DATA ABOUT THE OUTING AND INPUT
*THAT DATA TO EACH RECORD THE OPERATOR INDICATES HAS
*PARTICIPATED IN THE ACTIVITY
SET TALK OFF
CLEAR
STORE TROOPNR+[ ACTIVITY LOG] TO TITLE
@1,40-LEN(TITLE)/2 SAY TITLE
TEXT

       After you read this, you will be asked to provide certain data
     about the activity you are logging.  Once the computer has the re-
     quired data, it will then go through the Outpost roster asking you
     if each member participated in the activity.  At the prompt,
     simply type "Y" or "N" for each name.

endtext
wait
info = .f.
do while .not. info
clear
?
?[     Enter a <CR> at this next prompt to abort this procedure.]
?
accept [  Where did you go on this outing?  ] to destination
if len(trim(destination)) = 0
RETURN
endif
store upper(destination) to destination
?
accept [  What date did you leave the assemble area? (YYMMDD)  ] to tvldate
?
accept [  How many days were you out?  ] to daycount
?
accept [  How many nights were you out?  ] to nightcount
?
clear
?
?[   You went to:  ]+destination
?
?[   You left on: ]+tvldate
?
?[   You were out for ]
??daycount
??[ days and ]
??nightcount
??[ nights.]
?
?
wait [   Correct? (Y/N)  ] to correct
store upper(correct) to correct
if correct = [Y]
info = .t.
else
info = .f.
endif
enddo
clear
text

         You will now be presented with the name of each member of
     the Outpost.  Answer (Y/N) to each name prompt as that individual
     participated in the activity previously described.

endtext
WAIT
*computing date for filter to roster
store [/]+substr(TVLdate,1,2) to tvlyear
store substr(TVLdate,3,2) to tvlmonth
store [/]+substr(TVLdate,5,2) to tvlday
store tvlmonth+tvlday+tvlyear to tvlfilt
SELECT A
use ROSTER
index on lname+fname to temp
SET FILTER TO BEGDATE <=ctod(tvlfilt)
GO TOP
select b
use ACTYLOG
select a
do while .not. eof()
clear
?[Did ]+trim(fname)+[ ]+trim(lname)+[ participate?]
wait [(Y/N?) ] to part
store upper(part) to part
if part = [N]
skip
loop
endif
store mbrnr to lognr
select b
append blank
replace mbrnr with lognr
replace location with destination
replace date with tvldate
replace days with VAL(daycount)
replace nights with VAL(nightcount)
select a
skip
enddo
close databases
RETURN
*end trpacty
*____________________________________________________________________________

*A procedure to fill records in ATNDGEN.DBF, which will prepare data for
*a visual report on troop attendance
procedure PRINATT
PARAMETER PRINSTAT
set decimal to 0
CLEAR
text
  In order to compute the attendance averages for your Rangers, you must
  first define the period of time in which you are interested.  The first
  date you will be asked to type in will be the earliest date you want
  considered.  The second date you will be asked for is the latest date you
  want considered. This module does not access Commander's records
  REMEMBER: The format for the dates is numbers, YYMMDD; 890203 would mean
  3 February 1989.

endtext
allright = .f.
Do while .not. allright
ACCEPT [ Type in the Begin Date: ] to opendate
IF LEN(LTRIM(OPENDATE)) = 0
?[     This field requires data. No blanks here, please.]
loop
endif
?
?
ACCEPT [ Type in the End Date: ] to closedate
IF LEN(LTRIM(closeDATE)) = 0
?[   This field requires data. No blanks here, please.]
loop
endif
?
?
?[  You want to consider only information on attendance between ]
??opendate
?[ and ]
??closedate
?
wait [ Is this correct? (Y/N) ] TO ALLRIGHT
STORE UPPER(ALLRIGHT) TO ALLRIGHT
IF ALLRIGHT = [N]
allright = .f.
@12,0 CLEAR
LOOP
else
allright = .t.
ENDIF
ENDDO WHILE .NOT. ALRIGHT
clear
SET TALK OFF
?
?[Now processing data to generate the report you requested.]
?[Please stand by.]
goforit = .t.
select 1
use ROSTER
inde on lname+fname to temp
set filter to mbrnr < 499
go top
select 2
use ATTEND
index on date to temp1
set filter to date > opendate .and. date < closedate
go top
do while goforit
select 1
store trim(fname)+[ ]+trim(lname) to holdname
store mbrnr to getnr
STORE DTOC(BEGDATE) TO MBEGDATE
STORE SUBSTR(MBEGDATE,7,2) TO FIRSTTHIRD
STORE SUBSTR(MBEGDATE,1,2) TO SECONDTHIRD
STORE SUBSTR(MBEGDATE,4,2) TO THIRDTHIRD
STORE FIRSTTHIRD+SECONDTHIRD+THIRDTHIRD TO MBEGDATE
select 2
count all for mbrnr = getnr to atndcount
COUNT ALL FOR MBRNR = 0 .AND. DATE >= MBEGDATE TO TOTPOSS
select 3
use atndgen
GO BOTTOM
append blank
repl scoutname with holdname
repl totattend with atndcount
repl possattend with totposs
select 1
skip
if .not. eof()
loop
else
goforit = .f.
endif
enddo while goforit
close databases
use atndgen
INDE ON SCOUTNAME TO ATNDTEMP
go top
clear screen
do case
case prinstat = [V]
report form PRNtatnd
wait
case prinstat = [P]
report form PRNTATND to print
EJECT
endcase
close data
run del *.NTX
USE ATNDGEN
ZAP
CLOSE DATABASES
RETURN
*end prinatt
*___________________________________________________________________________
*A procedure to print a Transfer Form on a Ranger/Commander in Outpost
procedure prinindv
*Determines proper record for transfer sheet
SET TALK OFF
FINISHED = .F.
do while .not. finished
clear
ACCEPT [Which Member's record do you want to print?  ] to getname
if len(trim(getname)) = 0
RETURN
endif
sTORE UPPER(getname) to getname
USE ROSTER
index on lname+fname to temp
go top
FIND &getname
?
proper = .n.
clear
do while .not. proper
?[  The Individual Record to be printed belongs to:]
?[        ]+trim(fname)+[ ]+trim(lname)
?
wait [Correct?  (Y/N)  ] to correct
store upper(correct) to correct
if correct = [N]
skip
loop
endif CORRECT = [N]
proper = .y.
enddo WHILE .NOT. PROPER
store mbrnr to getnumber
STORE FNAME TO NAME
store begdate to started
store dtoc(started) to started1
store substr(started1,7,2) to year
store substr(started1,1,2) to month
store substr(started1,4,2) to day
store year+month+day to started
finished = .t.
enddo while .not. finished
*DISABLES SCREEN TO SPEED PROCESS
CLEAR
?
?[Printing an Individual Record for ]+trim(fname)+[ ]+trim(lname)
*Prints header data for the report
SET CONsOLE OFF
set prin on
?mboldon
set prin off
SET DEVICE TO PRINT
@ 2,40-len([ASSEMBLIES OF GOD ROYAL RANGERS])/2 SAY [ASSEMBLIES OF GOD ROYAL RANGERS]
@ 4,40-len(DISTRICT)/2 SAY DISTRICT
@ 5,40-len(TROOPNR)/2 SAY TROOPNR
@ 7,40-LEN([INDIVIDUAL MEMBER'S RECORD])/2 SAY [INDIVIDUAL MEMBER'S RECORD]
SET PRIN ON
?
?[ PREPARED ON:  ]
??DATE()
?
?
?[Name: ]+trim(fname)+[ ]+trim(lname)
?mboldoff+[Address: ]+trim(address)+[; ]+trim(city)+[ ]+state+[  ]+zip+[ ]+plus4
?[________________________________________________________________________]
SET PRINT OFF
CLOSE DATA
SET PRINT ON
?
?[ADVANCEMENT RECORD:]
?
?[Advancement Level Attained   Date Attained]
?[--------------------------   -------------]
SET PRINt off
USE ADVANCE
INDEX on earndate to temp
SET FILTER TO MBRNR = GETNUMBER
GO TOP
DO WHILE .NOT. EOF()
SET PRINT ON
?RANK+[                    ]+EARNDATE
IF EOF()
SET PRINT OFF
EXIT
ELSE
SKIP
ENDIF  EOF()
ENDDO WHILE .NOT. EOF()
CLOSE DATA
SET PRINT ON
?
?
?[MERITS EARNED:]
?
?[BADGE                    DATE EARNED]
?[--------------------     -----------]
SET PRINT OFF
USE MERIT
INDEX on earndate to temp
SET FILTER TO MBRNR = GETNUMBER
GO TOP
DO WHILE .NOT. EOF()
SET PRINT ON
?BADGE+[        ]+EARNDATE
IF EOF()
SET PRINT OFF
EXIT
ELSE
SKIP
ENDIF EOF()
ENDDO WHILE .NOT. EOF()
CLOSE DATA
SET PRINT ON
?
?
?[OFFICES HELD:]
?
?[OFFICE                      FROM             TO]
?[-------------------        ------          ------]
SET PRINT OFF
USE OFFICE
INDEX on begdate to temp
SET FILTER TO MBRNR = GETNUMBER
GO TOP
DO WHILE .NOT. EOF()
IF LEN(TRIM(ENDDATE)) = 0
END = [PRESENT]
ELSE
END = ENDDATE
ENDIF
SET PRINT ON
?office+[        ]+BEGDATE+[            ]+END
SET PRINT OFF
IF EOF()
EXIT
ELSE
SKIP
ENDIF EOF()
ENDDO WHILE .NOT. EOF()
CLOSE DATA
SET PRINT ON
?
?
?[TRAINING RECEIVED:]
?
?[TRAINING SESSION OR COURSE                     DATE COMPLETED]
?[--------------------------                     --------------]
SET PRINT OFF
USE TRAINING
INDEX on datecompl to temp
SET FILTER TO MBRNR = GETNUMBER
GO TOP
DO WHILE .NOT. EOF()
SET PRINT ON
?TNG+[           ]+DATECOMPL
IF EOF()
SET PRINT OFF
EXIT
ELSE
SKIP
ENDIF EOF()
ENDDO WHILE .NOT. EOF()
CLOSE DATA
SET PRINT ON
?
?
?[OUTPOST ACTIVITY PARTICIPATION:]
?
?[LOCATION                        DATE       NR OF NIGHTS  ]
?[-------------------------      ------      ------------]
SET PRINT OFF
USE ACTYLOG
INDEX on date to temp
SET FILTER TO MBRNR = GETNUMBER
GO TOP
DO WHILE .NOT. EOF()
SET PRINT ON
?LOCATION+[      ]+DATE+[            ]+LTRIM(STR(NIGHTS))
IF EOF()
SET PRINT OFF
EXIT
ELSE
SKIP
ENDIF EOF()
ENDDO WHILE .NOT. EOF()
CLOSE DATA
SET PRINT ON
?
?
?[UNIFORM INSPECTION DATA:]
?
?[DATE OF INSPECTION       SCORE]
?[------------------       -----]
SET PRINT OFF
USE UNIFORM
INDEX on date to temp
SET FILTER TO MBRNR = GETNUMBER
GO TOP
DO WHILE .NOT. EOF()
SET PRINT ON
?[     ]+DATE+[              ]
??SCORE
IF EOF()
SET PRINT OFF
EXIT
ELSE
SKIP
ENDIF EOF()
SET PRINT OFF
ENDDO WHILE .NOT. EOF()
CLOSE DATA
IF GETNUMBER < 500
USE ATTEND
DO WHILE .NOT. EOF()
INDE ON DATE TO TEMP
SET FILTER TO MBRNR = 0 .AND. DATE >= [&STARTED]
GO TOP
COUNT ALL TO POSSATND
SET FILTER TO MBRNR = GETNUMBER
GO TOP
COUNT ALL TO ATTENDED
CLOSE DATA
SET PRINT ON
?
?
?[ATTENDANCE SUMMARY:]
?
?[ Since joining the Outpost (or since the Outpost started using RR TRACKER),]
?[ Ranger ]+getname+[ has attended ]
??LTRIM(STR(attended))
??[ out of ]
??LTRIM(STR(POSSATND))
??[ Troop meetings. Using these]
?[ figures, his attendance average is ]
??LTRIM(STR(round((ATTENDED/POSSATND)*100,2)))
??[%.]
ENDDO WHILE .NOT. EOF()
ENDI ( MBRNR < 500)
SET PRINT ON
?
?
?[I CERTIFY THAT THE ABOVE INFORMATION IS CORRECT BASED UPON]
?[ALL INFORMATION AVAILABLE FROM TROOP RECORDS]
?
?
?
?
?[                                   OUTPOST COMMANDER]
SET PRINT OFF
close data
run del *.ntx
EJECT
SET DEVICE TO SCREEN
SET CONSOLE ON
RETURN
*END PRININDV
*____________________________________________________________________________
procedure PRINSKIL
*A PROGRAM TO DETERMINE WHICH RANGER HAVE SPECIFIED SKILLS OR TRAINING.
PARAMETER PrinStat
CLEAR
SET TALK OFF
TEXT

   This module will provide you with a printed list of Rangers or Commanders
   in your Outpost who possess whichever skills you tell the computer you're
   looking for.  This assumes, of course, that records exist in either the
   Merit database or the Training database which might refer to those skills.

   The computer will ask you for the skill you're looking for.  What it
   needs, to then research your records, is a word, or even a partial word,
   that might have been entered as a Badge in the Merit file or as a course
   title or subject in the Training file.  The less specific you make your
   search specification, the more likely you are to find something in these
   databases that responds; unfortunately, you are also more likely to get a
   lot more junk this way. It's a gamble and practice makes your selection
   process more successful.

endtext
wait
clear
text
   Here's an example.

   Over a period of time, you have entered many First Aid Awards in the Merit
   database.  You've also entered several non-Red Cross First Aid Awards
   in the Training database as the one place to enter these miscellaneous
   skills. You've also, unfortunately, entered a basic photography training
   course, entitled "First Attempts at Pictures", your Guide attended. A
   search for people with "First" skills will get this photographic entry as
   well as the "First Aid" entries. Of course, using "First Aid" as your
   selection criteria will also get you a listing of "First Aid for Canoes,"
   a course your Lieutenant Commander took last year!

   Take your time and practice a little.  This module will help your Outpost
   plan their year once you get the hang of it. I mean, it's only paper!

endtext
wait
skilready = .f.
do while .not. skilready
clear
?
?[  Now, which skill do you want to search for?]
?
ACCEPT [  Enter skill, now:  ] to getskill
if len(ltrim(getskill)) = 0
?[  No blanks in this field, please.]
loop
endif
skilready = .t.
store upper(getskill) to getskill
enddo while .not. skilready
?
?
?[  You are tracking which Rangers or Commanders might have some skill in]
?[  ]+getskill+[.]
?[  Notice that the skills are, now, in upper case.  This was done because]
?[  RR TRACKER automatically puts all data entries into upper case and]
?[  this will ensure that you will find something, if it was ever entered.]
?
wait
clear
?
?[Please stand by.]
?
IF prinstat = [P]
set console off
endif
finished = .f.
do while .not. finished
if prinstat = [P]
set print on
endif
clear
?
?
?[This is a skill search of MERIT.DBF and TRAINING.DBF for any entry]
?[which approximates:]
?[               ]+ getskill
?
?[FROM MERIT.DBF]
?
set print off
linecount = 9
SELECT A
USE MERIT
inde on badge to temp
select b
use ROSTER
select a
set filter to [&getskill] $ badge
go top
do while .not. eof()
if eof()
if prinstat = [P]
set print on
endif
?[  Nothing meeting that description was found in MERIT.DBF.]
?
set print off
linecount = linecount+2
endif
Store badge to printskill
store mbrnr to getnumber
select b
locate for mbrnr = getnumber
store trim(fname)+[ ]+lname to printname
select a
if prinstat = [P]
set print on
endif
?printname+[   ]+printskill
set print off
linecount = linecount+1
if prinstat = [V] .and. linecount >=23
wait
linecount = 0
endif
skip
enddo while .not. eof()
close databases
erase temp.ntx
if prinstat = [P]
set print on
endif
?
?
?[FROM TRAINING.DBF]
?
set print oFF
linecount = linecount+4
SELECT A
USE TRAINING
inde on tNG to temp
select b
use ROSTER
select a
set filter to [&getskill] $ tNG
go top
do while .not. eof()
if eof()
if prinstat = [P]
set print on
endif
?[Nothing meeting that description was found in TRAINING.DBF.]
?
set print off
exit
endif
store TNG to printskill
store mbrnr to getnumber
select b
locate for mbrnr = getnumber
store trim(fname)+[ ]+lname to printname
select a
if prinstat = [P]
set print on
endif
?printname+[   ]+printskill
set print off
linecount = linecount+1
if prinstat = [V] .and. linecount >=23
wait
linecount = 0
endif
skip
enddo while .not. eof()
close databases
if prinstat = [P]
set print on
endif
?
set print oFF
do case
case prinstat = [P]
EJECT
case prinstat = [V]
wait
endcase
erase temp.ntx
erase temp1.ntx
finished = .t.
enddo while .not. finished
SET CONSOLE ON
SET DEVICE TO SCREEN
RETURN
*end prinskil
*__________________________________________________________________________
procedure honors
*a procedure that will list all honors [training, merit badge, advancement,
*etc.] recorded with a start date determined by the user.
clear
text

                      Pre-Council of Achievement Honors Listing

  This module will print a list of all honors [Advancment, Merits,
  Training, and Office Elections/Selections] that have been recorded since
  a date that you will supply.  This list is terribly useful in preparing
  for a Council of Achievement and can be used to check the data in your
  system against your Outpost's paper Advancment records.

  Verify that your printer is online and ready to work the press any key
  to continue this module.



endtext
wait [ ] to goforit
?
?
Accept [  What date do you want for the start of this run? (YYMM) ] to getdate
?
?[  Preparing and Printing Report.]
*printing header for the document
set console off
set device to printer
clear
@ 2,40-LEN(DISTRICT)/2 SAY DISTRICT
@ 3,40-LEN(TROOPNR)/2 SAY TROOPNR
@ 4,40-LEN([HONORS LISTING])/2 SAY [HONORS LISTING]
set device to screen
set print on
?
?[Printed on: ]+dtoc(date())
?
?
?[  Advancement Earned:]
linecount = 9
select 1
USE ROSTER
select 2
use ADVANCE
index on earndate to temp1
set filter to earndate > getdate
go top
do while .not. eof()
store mbrnr to getmember
select 1
locate for mbrnr = getmember
?trim(fname)+[ ]+trim(lname)+[    ]
select 2
??rank+[ ]+earndate
linecount = linecount + 1
skip
enddo while .not eof()
IF LINECOUNT > 55
linecount = 0
eject
set print on
?
?
?
set print off
ENDIF
set print on
?
?
?[  Merits Earned:]
?
linecount = linecount + 4
select 2
use MERIT
index on earndate to temp1
set filter to earndate > getdate
go top
recthere = .t.
do while .not. eof()
store mbrnr to getmember
select 1
locate for mbrnr = getmember
?trim(fname)+[ ]+trim(lname)+[    ]
select 2
??badge+[  ]+earndate
linecount = linecount + 1
skip
enddo while .not eof()
IF LINECOUNT > 55
linecount = 0
eject
set print on
?
?
?
set print off
ENDIF
set print on
?
?
?[  Training Recognition Earned:]
?
linecount = linecount + 4
select 2
use TRAINING
index on datecompl to temp1
set filter to datecompl > getdate
go top
do while .not. eof()
store mbrnr to getmember
select 1
locate for mbrnr = getmember
?trim(fname)+[ ]+trim(lname)+[    ]
select 2
??trim(tng)+[  ]+datecompl
linecount = linecount + 1
skip
enddo while .not eof()
IF LINECOUNT > 55
linecount = 0
eject
set print on
?
?
?
set print off
ENDIF
set print on
?
?
?[  Offices Elected to or Selected to:]
?
linecount = linecount + 4
select 2
use OFFICE
index on begdate to temp1
set filter to begdate > getdate
go top
do while .not. eof()
store mbrnr to getmember
select 1
locate for mbrnr = getmember
?trim(fname)+[ ]+trim(lname)+[    ]
select 2
??trim(office)+[  ]+begdate
linecount = linecount + 1
skip
enddo while .not eof()
set prin off
IF LINECOUNT > 55
linecount = 0
eject
set print on
?
?
?
set print off
ENDIF
set print off
set device to screen
eject
set console on
clear
?
?
?
?[  Report finished.  Press any key to continue.]
wait [ ]
run del *.ntx
RETURN
*end honors
*--------------------------------------------------------------------------
PROCEDURE PRINCON
*A PROCEDURE TO INITIALIZE PRINTER CONTROL CHARACTERS USED WITHIN PARTYTRK
CLEAR
IF .NOT. PRINDEF
TEXT

    RR TRACKER has determined that the printer to be used with this
    system has not been defined. Please take a moment to do this now.
    Before proceeding, please consult your User's Manual for detailed
    instructions on how to respond to the questions which will follow.

ENDTEXT
WAIT
ELSE
TEXT

    You have chosen to change the printer definition for use with this
    system.  Before proceeding, please take a moment to consult your
    User's Manual for detailed instructions on how to respond to the
    questions which will follow

ENDTEXT
WAIT
ENDIF (.NOT. PRINDEF)
CLEAR
PRINIDENT = [   ]
TEXT

     The User'S Manual listed 100 printers that this program can support.
     Please type in the number of the printer you are using:

ENDTEXT
@4,34 GET PRINIDENT PICTURE [999]
READ
USE PRINTERS
LOCATE FOR PR_NUMBER = VAL(PRINIDENT)
STORE PR_NAME TO MPR_NAME
CLEAR
?
?
?[    You have selected the ]+TRIM(Mpr_name)+[.]
?[    RR TRACKER will now update the printer data that it requires]
?[    to better support your requirements.]
?[    ]
STORE TRIM(PR_NAME) TO MPRNAME
??[.]
STORE TRIM(PR_SETUP) TO MPRSETUP
??[.]
STORE TRIM(PR_RESET) TO MPRRESET
??[.]
STORE TRIM(PR_6LPI) TO MPR6LPI
??[.]
STORE TRIM(PR_8LPI) TO MPR8LPI
??[.]
STORE TRIM(PR_10CPI) TO MPR10CPI
??[.]
STORE TRIM(PR_12CPI) TO MPR12CPI
??[.]
STORE TRIM(PR_COMPR) TO MPRCOMP
??[.]
STORE TRIM(PR_BDON) TO MBOLDON
??[.]
STORE TRIM(PR_BDOFF) TO MBOLDOFF
??[.]
STORE TRIM(PR_ULON) TO MPRULON
??[.]
STORE TRIM(PR_ULOFF) TO MPRULOFF
??[.]
STORE TRIM(PR_ITON) TO MPRITON
??[.]
STORE TRIM(PR_ITOFF) TO MPRITOFF
??[.]
RELEASE PRINIDENT
PRINDEF = .T.
SAVE TO IDENT
WAIT
RETURN
*-------------------------------------------------------------------------
PROCEDURE FILEBACK
clear
text
               BACKING UP RR TRACKER DATA TO FLOPPY DISK

 The purpose of this module is to back up data from your hard disk drive
 onto a formatted floppy disk in Drive A.  If your system is not a Hard Disk
 system and is, instead, a double floppy disk drive system, back up your data
 disk by simply copying the data disk you normally use onto a blank disk
 using the "DISKCOPY" command.

 If you wish to perform this backup function now, press "Y" at the next
 prompt.  Otherwise, simply press the ENTER key at the prompt and you will be
 taken back to the TROOP TRACKER Main Menu.

endtext
wait [ Press Y or Enter, now. ] to runback
if len(runback) = 0
RETURN
endif
*verifying that a blank disk is in backup drive
?
?
?[  PLEASE ENSURE THAT A FORMATTED, BLANK DISK IS IN DRIVE ]+BACKDRIVE+[: NOW.]
WAIT
clear
?
?[  Copying data files to backup diskette.  Please stand by.]
?
SET CONSOLE OFF
copy FILE ROSTER.dbf TO &BACKDRIVE:\ROSTER.DBF
copy FILE ACTYLOG.DBF TO &BACKDRIVE:\ACTYLOG.DBF
copy FILE ADVANCE.DBF TO &BACKDRIVE:\ADVANCE.DBF
copy FILE ATNDGEN.DBF TO &BACKDRIVE:\ATNDGEN.DBF
copy FILE ATTEND.DBF  TO &BACKDRIVE:\ATTEND.DBF
copy FILE FORMRMBR.DBF TO &BACKDRIVE:\FORMRMBR.DBF
copy FILE MERIT.DBF TO &BACKDRIVE:\MERIT.DBF
copy FILE OFFICE.DBF TO &BACKDRIVE:\OFFICE.DBF
copy FILE RETURN.DBF TO &BACKDRIVE:\RETURN.DBF
copy FILE TRAINING.DBF TO &BACKDRIVE:\TRAINING.DBF
COPY FILE UNIFORM.DBF TO &BACKDRIVE:\UNIFORM.DBF
SET CONSOLE ON
?
?[Data has been copied.  Please place this disk in a safe storage place.]
RETURN
*end fileback
*___________________________________________________________________________
PROCEDURE ATTEND
*A PROGRAM THAT WILL ALLOW OPERATOR TO LOG MEETING ATTENDANCE
*THE PROGRAM WILL SOLICIT THE DATE OF THE MEETING AND INPUT THAT DATA TO
*EACH member's RECORD THE OPERATOR INDICATES HAS PARTICIPATED IN THE ACTIVITY
CLEAR
TEXT

                             OUTPOST ATTENDANCE LOG

  After you read this, you will be asked to provide the date of the meeting
  for which you want to log attendance.  Once the computer has the re-
  quired data, it will then go through the Outpost roster asking you
  if each member attended the meeting.  At the prompt, simply type "Y" or
  "N" for each name. RR TRACKER does not keep attendance data on Commanders.
endtext
WAIT
*Obtaining the needed data for subsequent posting
info = .f.
do while .not. info
clear
?
?
accept [  What is the date of the meeting?  (YYMMDD)  ] to meetdate
if len(trim(meetdate)) = 0
return
endif
clear
?
?[  The meeting date is: ]+meetdate
?
?
wait [  Correct? (Y/N)  ] to correct
store upper(correct) to correct
if correct = [Y]
info = .t.
else
info = .f.
endif
enddo
clear
text

    You will now be presented with the name of each member of
the Outpost.  Answer (Y/N) to each name prompt as that individual
participated in the activity previously described.

endtext
WAIT
*computing date for filter to roster
store [/]+substr(meetdate,1,2) to tvlyear
store substr(meetdate,3,2) to tvlmonth
store [/]+substr(meetdate,5,2) to tvlday
store tvlmonth+tvlday+tvlyear to tvlfilt
use ROSTER
index on lname+fname to temp
SET FILTER TO mbrnr < 500 .and. BEGDATE <=ctod(tvlfilt)
GO TOP
select b
use ATTEND
APPEND BLANK
REPL MBRNR WITH 0
REPL DATE WITH MEETDATE
select a
do while .not. eof()
clear
?[  Did ]+trim(fname)+[ ]+trim(lname)+[ attend?]
wait [  (Y/N?)  ] to part
store upper(part) to part
if part = [N]
Skip
loop
endif
store mbrnr to lognr
select b
append blank
replace mbrnr with lognr
replace date with meetdate
select a
skip
enddo
close databases
run del *.ntx
RETURN
*end ATTEND
*___________________________________________________________________________
PROCEDURE REGREM
*REGISTRATION REMINDER SCREEN
CLEAR
TEXT
 **********************************                 _______
 *        RANGER TRACKER          *            ____|__     |               (R)
 *         VERSION 1.0            *         --|       |    |-------------------
 *      EVALUATION VERSION        *           |   ____|__  |  Association of
 * An Automated Records System for*           |  |       |_|  Shareware
 *      Royal Ranger Outposts     *           |__|   o   |    Professionals
 *                                *         -----|   |   |---------------------
 **********************************              |___|___|    MEMBER
  Copyright @1993 Robert Barrentine

  The program you are using is a SHAREWARE program. You may use this program
  for 60 days without paying the registration. If you decide you like this
  program and are going to continue to use it, you must register the program
  with Robert Barrentine, the copyright holder. Registration will bring you
  unlimited written support, unlimited toll-free telephonic support, the next
  update to RANGER TRACKER, when issued, free, and a disk containing a program
  which will remove this reminder screen.

  To register RANGER TRACKER, print out the REGISTER.DOC text file, fill it in,
  and mail the form, with your check for US$35.00 to the address on the form.
  Please support the SHAREWARE concept and register this program.

ENDTEXT
WAIT
*--------------------------------------------------------------------------